Shareware Super Platinum 8

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / BORUSR2.ZIP;1 / MENU.PRG < prev next >

Wrap

Text File | 1992-07-06 | 10.0 KB | 270 lines

*------------------------------------------------------------------------------- *-- Program....: MENU.PRG *-- Programmer.: Ken Mayer, SofTech, Inc. *-- Date.......: 11/18/1991 *-- Written for: dBASE IV, 1.1 *-- Notes......: This is the front-end to the BOR-BBS Users listing system ... *-- This system is based on the database created by Tony Lima *-- and written to interface with that. Permission to distribute *-- freely all programs associated with this system (including *-- the procedure file PROC.PRG) is given by the author. *-- Revised....: 03/19/1992 -- Added configuration options in menu. *-- 05/14/1992 -- Started re-working system to incorporate quite *-- a few new features ... includes Mouse support in 1.5. *-- 05/31/1992 -- JOEY added the 'save' of color settings, so that *-- the user's original settings are restored, no matter what *-- gets done here ... *-- 06/06/1992 -- Ken -- I am going back through this whole *-- system today, and working on commenting it more heavily, *-- with the theory that it may help others who want to use *-- parts of this code. *-- 06/15/1992 -- Another attempt at fixing the color problems. *-- Am setting them specifically here. No calling on the SETCOLOR *-- and SETCOLOR2 routines in PROC.PRG. *-- Database...: ATUSERS.DBF *-- MDX...: ATUSERS.MDX *-- Index TAG: STATE Key: upper(hstate)+upper(bstate) *-- Index TAG: BORBBS_ID Key: upper(borbbs_id) *-- Index TAG: LAST_NAME Key: upper(last_name) *-- Index TAG: COMPANY Key: upper(company) *-- Index TAG: BZIP Key: BZIP *-- Index TAG: BSTATE Key: upper(bstate) *-- Index TAG: HZIP Key: HZIP *-- Index TAG: HSTATE Key: upper(hstate) *-- Memo File: ATUSERS.DBT *------------------------------------------------------------------------------- *-- set the procedure file set procedure to proc && a slimmed down PROC22, with mouse stuff *-- basic stuff -- save user's settings. Mostly important for systems *-- that drop the user back to the dot prompt in dBASE. If you have a system *-- that never lets the user see the dot prompt, this stuff isn't as necessary. cStatus = set("STATUS") && status line set status off cTalk = set("TALK") && 'talk' mode set talk off cEscape = set("ESCAPE") && 'escape' ... only on when I want it on. set escape off cBell = set("BELL") && don't beep at me, ok? set bell off cScore = set("SCOREBOARD") && turn the scoreboard off ... set scoreboard off cDeleted = set("DELETED") && I want to see 'deleted' records ... set deleted off cSafety = set("SAFETY") *-- get color settings coming into to program cStrtColor = set("ATTRIBUTES") *-- Deal with the mouse. This really only works in version 1.5 of dBASE, *-- but should not cause any problems with version 1.1 (if no mouse driver, *-- the rest is ignored). Basically the ISMOUSE() routine turns off the *-- mouse driver (in some cases, like Microsoft and Logitech, at the very *-- least), and the SETMOUSE routine will toggle the mouse ... if val(right(trim(version()),3)) > 1.1 && if version of dBASE > 1.1 if ismouse() && turn mouse off if it exists public c_Mouse && necessary for MOUSE routines c_Mouse = "OFF" && if there's a driver, we're turning it off on key label alt-m do setmouse && but user can toggle with <Alt>M endif endif *-- These color vars are used later ... (and ALL OVER the place), and should *-- be (and are) declared as global. public cl_wind1,cl_wind2,cl_wind3,cStand,cStand2,cStand3 *-- determine color configuration ... if .not. file("COLOR.MEM") && if this file does not exist, ask ... *-- check for a monochrome monitor adaptor card -- if IsColor() returns *-- .t., then the machine THINKS it has a color monitor ... if iscolor() && if it says .f. then it's gotta have different coding. *-- check for color if yesno(.t.,"Can your computer show color?","","","rg+/gb,w+/n,rg+/gb") do center with 12,80,"rg+/gb","Setting color memvars ..." *-- set the colors ... cStand = "w+/b" cStand2 = "rg+/gb" cStand3 = "rg+/r" *-- now ask about VGA ... @12,0 clear *-- VGA? if yesno(.t.,"Do you have VGA?","","","rg+/gb,w+/n,rg+/gb") *-- copy color description to a MEM file used with cdefault.prg do center with 12,80,"rg+/gb","Setting VGA colors ..." *-- copy the VGA 'default' gun descriptions ... set console off run copy clrdesc.fil clrdesc.mem > nul set console on do cdefault && load color definitions ... @12,0 clear endif *-- monochrome monitor, but with CGA (or higher) adaptor ... else cStand = "w+/n" cStand2 = "n/w" cStand3 = "n+/w" endif && iscolor() *-- save to a memfile ('normal' mono or color ...) save all like cstand* to color.mem *-- if we're here, we have a monochrome adaptor, and a monochrome monitor ... else cStand = "w/n" && 'normal' text cStand2 = "wI/n" && inverse video cStand3 = "wU/n" save all like cStand* to color.mem endif *-- if here, COLOR.MEM exists, and all those questions ain't necessary ... else restore from color additive && file exists, load colors from COLOR.MEM *-- if they have VGA, the system should have set CLRDESC.MEM ... *-- so we want to load the VGA color combinations ... if file("CLRDESC.MEM") do cDefault endif endif *-- Now that we have some colors to work from, set the standard windows .... cl_wind1 = "&cStand2,&cStand,&cStand2" && the usual cl_wind2 = "&cStand3,&cStand2,&cStand3" && error box cl_wind3 = "&cStand,&cStand2,&cStand" && others ...? *-- set main colors set color of normal to &cStand set color of message to &cStand2 set color of box to &cStand2 set color of highlight to &cStand *-- one new item ... check for printer definitions ... if .not. file("PRINTER.MEM") do center with 12,80,"&cStand2","Loading Printer Configuration program ..." do pconfig && printer configuration program ... endif *-- opening screen ... do jazclear do open_screen *-- opening titles save screen to tempscrn define window title from 8,20 to 13,60 color &cl_wind2 double do shadow with 8,20,13,60 && exploding shadow routine activate window title set cursor off *-- if the mouse is around ... if type("C_MOUSE") = "C" do center with 0,40,"","** MOUSE INSTRUCTIONS **" do center with 2,40,"","Toggle the mouse by pressing" do center with 3,40,"","<Alt>M (on/off ...)" x=inkey(5) clear endif *-- normal title box ... do center with 0,40,"","BOR-BBS Users" do center with 1,40,"","Address/E-Mail Info" do center with 3,40,"","(c) 1991, 1992, Kenneth J. Mayer" x=inkey(5) set cursor on deactivate window title release window title restore screen from tempscrn release screen tempscrn *-- define and then activate menu ... do def_menu if at("RUNTIME",upper(version())) = 0 do shadow with 7,28,16,49 && if not runtime, shadow for full menu else do shadow with 7,28,15,49 && otherwise, shadow for menu without && last option endif activate popup pMain do leave_proc clear all && don't want variables left over when 'quit' *------------------------------------------------------------------------------- *-- End of Main portion of Program: MENU.PRG *------------------------------------------------------------------------------- PROCEDURE def_menu && define the menu *-- Menu definition for BOR-BBS Users define popup pMain from 7,28 define bar 1 of pMain prompt " BOR-BBS Users Menu " skip define bar 2 of pMain Prompt replicate(chr(196),20) skip define bar 3 of pMain Prompt " Add Data"; message "Add new records" define bar 4 of pMain Prompt " Search/Update Data"; message "Search for and View/Edit/Delete data" define bar 5 of pMain Prompt " Print Report"; message "Generate a list of users (hard-copy/screen/ASCII file)" define bar 6 of pMain prompt " Configuration"; message "Modify color/printer configuration" define bar 7 of pMain Prompt " Quit"; message "Leave dBASE, back to Operating System (DOS/Windows/DV/OS2 ...)" *-- allow this option ONLY if user is using dBASE ... if at("RUNTIME",upper(version())) = 0 define bar 8 of pMain Prompt " Exit to dBASE" endif on selection popup pMain do choice RETURN PROCEDURE choice && Choice from menu ... @24,0 clear do case case bar() = 3 do borentr && enter data case bar() = 4 do boredit && edit/delete data case bar() = 5 do borrep && generate listings case bar() = 6 do config && configure the system case bar() = 7 close all && exit quit case bar() = 8 deactivate popup && drop back to dot prompt .. endcase RETURN PROCEDURE Leave_Proc && cleanup after the menu ... do jazclear set status &cStatus set escape &cEscape set bell &cBell set scoreboard &cScore set deleted &cDeleted set color to &cStand cReturn = chr(17)+chr(196)+chr(217) && return key ... @10,25 say "Re-start menu with: DO MENU"+cReturn color &cStand3 @11,27 say "Leave dBASE with: QUIT"+cReturn color &cStand3 *-- restore colors do ReColor with cStrtColor set talk &cTalk close all && files *-- release popup from memory release popup pMain RETURN *------------------------------------------------------------------------------- *-- The real END OF PROGRAM: MENU.PRG *-------------------------------------------------------------------------------